home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Software Contest 3 / FM Towns Software Contest 3.iso / exp / bpp / no1 / pi.bpp < prev    next >
Encoding:
Text File  |  1994-01-07  |  1.5 KB  |  80 lines
  1. '
  2. ' 分割統治法により円周率を求める
  3. '       参考文献　Ｃマガジン９２年１０月号
  4. '                 実践アルゴリズム戦略　解法のテクニック（松田　晋）
  5. '
  6.  
  7. #define SCALE 320
  8.  
  9. clear ,,4096    ' スタックを大きめに設定しておく
  10. defdbl a-z
  11. makestack 0,1024,0,1024
  12.  
  13. call main
  14. end
  15.  
  16. sub square(x,y,length,fill%)
  17.   local x0%, y0%, x1%, y1%
  18.   x0%=x*SCALE
  19.   y0%=y*SCALE
  20.   x1%=(x+length)*SCALE
  21.   y1%=(y+length)*SCALE
  22.   if fill% then
  23.     call boxfill(x0%,y0%,x1%,y1%)
  24.   else
  25.     call box(x0%,y0%,x1%,y1%)
  26.   endif
  27. endsub
  28.  
  29. sub area(bybody r,x,y,length)
  30.   local r1,r2,r3,r4
  31.   if x^2+y^2>1.0 then
  32.     call square(x,y,length,0)
  33.     r=0.0
  34.     exitsub
  35.   elseif (x+length)^2+(y+length)^2<1.0 then
  36.     call square(x,y,length,1)
  37.     r=length^2
  38.     exitsub
  39.   elseif length<=eps then
  40.     call square(x,y,length,0)
  41.     r=length^2*0.5
  42.     exitsub
  43.   else
  44.     length=length*0.5
  45.     call area(r1,x,y,length)
  46.     call area(r2,x,y+length,length)
  47.     call area(r3,x+length,y,length)
  48.     call area(r4,x+length,y+length,length)
  49.     r=r1+r2+r3+r4
  50.     exitsub
  51.   endif
  52. endsub
  53.  
  54. sub main
  55.   local pi
  56.   input "許容誤差 ";eps
  57.   call initgraph
  58.   call circleedge(0,0,SCALE)
  59.   call area(pi,0,0,1.0)
  60.   pi=pi*4
  61.   print "π=";pi
  62. endsub
  63.  
  64. sub initgraph
  65.   cls
  66. endsub
  67.  
  68. sub box(x0%,y0%,x1%,y1%)
  69.   line(x0%,y0%)-(x1%,y1%),pset,7,b
  70. endsub
  71.  
  72. sub boxfill(x0%,y0%,x1%,y1%)
  73.   line(x0%,y0%)-(x1%,y1%),pset,1,bf
  74.   line(x0%,y0%)-(x1%,y1%),pset,7,b
  75. endsub
  76.  
  77. sub circleedge(x%,y%,r%)
  78.   circle(x%,y%),r%
  79. endsub
  80.